home *** CD-ROM | disk | FTP | other *** search
/ MacTech 1 to 12 / MacTech-vol-1-12.toast / Source / MacTech® Magazine / Volume 06 - 1990 / 06.06 Jun 90 / PinUpMenu LSP / PinUpMenu.p < prev    next >
Encoding:
Text File  |  1989-08-06  |  7.2 KB  |  251 lines  |  [TEXT/PJMM]
  1. unit PinUpMain;
  2. {--This is the source code of the PinUpMenu XFCN--}
  3. {--Written by Steven Fuchs--}
  4. {--PO Box 129, Coram, NY 11727--}
  5.  
  6. interface
  7.     uses
  8.         XCMDIntF, XCMDUtils;
  9.     procedure MAIN (ParamPtr: XCMDPtr);
  10. implementation
  11.     type
  12.         MenuArray = array[0..15] of MenuHandle;
  13.         StrArray = array[0..15] of str255;
  14.  
  15.     procedure MAIN (ParamPtr: XCMDPtr);
  16.         var
  17.             TheMenus: MenuArray;
  18.             TheParams: StrArray;
  19.             PinUpWindow: WindowPtr;
  20.             OldPort: GrafPtr;
  21.             EndRect: rect;
  22.             Name, TheAnswer: str255;
  23.             item: longint;
  24.  
  25.  
  26. {---HandleDrawing is a simple routine to draw our windows string---}
  27.         procedure HandleDrawing;
  28.         begin
  29.             MoveTo(PinUpWindow^.portrect.left + 2, PinUpWindow^.portrect.bottom - 4);
  30.             DrawString(Name);
  31.         end;
  32.  
  33. {---HandleThisUpdate determines the correct action to take in  response---}
  34. {---to an Update Event,  if the window is ours it calls HandleDrawing, if---}
  35. {---it is the Hypercard main window, it calls SendCardMessage, otherwise---}
  36. {---(most likely one of the tool pallettes) it removes the message---}
  37.         procedure HandleThisUpdate (LilWindow: WindowPtr);
  38.         begin
  39.             BeginUpdate(LilWindow);
  40.             if WindowPtr(LilWindow) = OldPort then
  41.                 SendCardMessage(ParamPtr, 'Go to this card')
  42.             else if WindowPtr(LilWindow) = PinUpWindow then
  43.                 HandleDrawing
  44.             else
  45.                 ValidRect(LilWindow^.portrect);
  46.             EndUpdate(LilWindow);
  47.         end;
  48.  
  49. {---GetParams is responsible for transferring the parameters---}
  50. {---sent to MAIN into our variables: Name, and the TheParams arrray}
  51.         function GetParams: boolean;
  52.             var
  53.                 NumOfMenus, z: integer;
  54.         begin
  55.             NumOfMenus := ParamPtr^.ParamCount - 1;
  56.             GetParams := NumOfMenus >= 1;
  57.             ZeroToPas(ParamPtr, ParamPtr^.params[1]^, Name);
  58.             for z := 1 to 15 do
  59.                 if z <= NumOfMenus then
  60.                     begin
  61.                         ZeroToPas(ParamPtr, ParamPtr^.params[z + 1]^, TheParams[z]);
  62.                         TheParams[z] := Include(',', TheParams[z], length(TheParams[z]) + 1);
  63.                     end
  64.                 else
  65.                     TheParams[z] := '';
  66.         end;
  67.  
  68. {---ReturnWindowRect must determine the length of the string “Name”---}
  69. {---Size the rectangle so the string fits nicely inside, and locate it so that---}
  70. {---it appears in the same spot regardless of screen size---}
  71.         procedure ComputeWindowRect;
  72.             var
  73.                 DummyPt: point;
  74.         begin
  75.             SetPt(DummyPt, 150, 100);
  76.             SetRect(EndRect, 0, 0, stringwidth(Name) + 20, 17);
  77.             LocaltoGlobal(DummyPt);
  78.             OffsetRect(EndRect, DummyPt.h, DummyPt.v);
  79.         end;
  80.  
  81. {---CreateWindow does just that, creating the window for us and setting up---}
  82. {--the default drawing characteristics---}
  83.         procedure CreateWindow;
  84.             var
  85.                 LongOne: LongInt;
  86.         begin
  87.             PinUpWindow := NewWindow(nil, EndRect, 'The Course', false, 3, nil, false, LongOne);
  88.             SetPort(PinUpWindow);
  89.             TextFont(0);
  90.             TextSize(12);
  91.             ShowWindow(PinUpWindow);
  92.             SelectWindow(PinUpWindow);
  93.         end;
  94.  
  95. {---HitCameInWindow holds our event loop, where it waits for a mousedown---}
  96. {---if this mousedown is within the window we return true, otherwise false.---}
  97.         function HitCameInWindow: boolean;
  98.             var
  99.                 Event: EventRecord;
  100.         begin
  101.             HitCameInWindow := false;
  102.             repeat
  103.                 SystemTask;
  104.                 if GetNextEvent(EveryEvent, Event) then
  105.                     case Event.What of
  106.                         MouseDown: 
  107.                             if PtInRect(Event.Where, EndRect) then
  108.                                 HitCameInWindow := true;
  109.                         UpdateEvt: 
  110.                             HandleThisUpdate(WindowPtr(event.message));
  111.                         ActivateEvt: 
  112.                             HandleDrawing;
  113.                         otherwise
  114.                     end
  115.             until Event.What = Mousedown;
  116.         end;
  117.  
  118. {---ReturnAndMaul is our parsing function, it reads the first item from---}
  119. {---the string indicated by Index and returns it. It then deletes that item---}
  120.         function ReturnAndMaul (Index: integer): str255;
  121.             var
  122.                 ThePlace: integer;
  123.         begin
  124.             ThePlace := Pos(',', TheParams[Index]);
  125.             if ThePlace = 0 then
  126.                 ReturnAndMaul := ''
  127.             else
  128.                 begin
  129.                     ReturnAndMaul := str255(copy(TheParams[Index], 1, ThePlace - 1));
  130.                     delete(TheParams[Index], 1, ThePlace);
  131.                 end;
  132.         end;
  133.  
  134. {---CreateSubMenu does just that, creating the menu with NewMenu and---}
  135. {---sets the correct fields in the main menu to indicate the submenu exists---}
  136.         procedure CreateSubMenu (Index: integer);
  137.             var
  138.                 swf, saf: char;
  139.         begin
  140.             swf := chr($1B);
  141.             saf := chr(240 + Index);
  142.             TheMenus[Index] := NewMenu(240 + Index, 'ASubMenu');
  143. {--Tell Mac OS we have a submenu--}
  144.             SetItemCmd(TheMenus[0], Index, swf);
  145. {--Tell Mac OS which Menu it is--}
  146.             SetItemMark(TheMenus[0], Index, saf);
  147.         end;
  148.  
  149. {---AddAllItems calls ReturnAndMaul repeatedly until there is nothing---}
  150. {---left of the string indicated by Index.  Each of the items up until---}
  151. {---that point is appended to the end of the submenu.---}
  152.         procedure AddAllItems (TIndex: integer);
  153.             var
  154.                 stripe: str255;
  155.                 x: integer;
  156.         begin
  157.             repeat
  158.                 stripe := ReturnAndMaul(TIndex);
  159.                 if stripe <> '' then
  160.                     AppendMenu(TheMenus[TIndex], Stripe);
  161.             until stripe = '';
  162. {--Insert our menu into hierarchical portion of MenuList--}
  163.             InsertMenu(TheMenus[TIndex], -1);
  164.         end;
  165.  
  166. {---BuildThoseMenus is the top layer, it creates the main menu and adds the---}
  167. {---items, decides if that item needs submenus and if so calls the procedures---}
  168. {---to add them---}
  169.         procedure BuildThoseMenus;
  170.             var
  171.                 Increment: integer;
  172.                 ScaredStr: str255;
  173.         begin
  174.             TheMenus[0] := NewMenu(240, 'MainMenu');
  175.             for increment := 1 to 15 do
  176.                 begin
  177.                     TheMenus[increment] := nil;
  178.                     ScaredStr := ReturnAndMaul(increment);
  179.                     if ScaredStr <> '' then
  180.                         begin
  181.                             AppendMenu(TheMenus[0], ScaredStr);
  182.                             if Pos(',', TheParams[increment]) <> 0 then
  183.                                 begin
  184.                                     CreateSubMenu(increment);
  185.                                     AddAllItems(increment);
  186.                                 end;
  187.                         end;
  188.                 end;
  189. {--Insert main menu into PopUp portion of Menu List--}
  190. {--Same call as for hierarchical menus--}
  191.             InsertMenu(TheMenus[0], -1);
  192.         end;
  193.  
  194. {---ConvertAnswer takes the longint returned from PopUpMenuSelect and---}
  195. {--Converts it to the proper string for return to Hypercard---}
  196.         function ConvertAnswer (TheL: longInt): str255;
  197.             var
  198.                 ThePrimary, TheSecondary: str255;
  199.         begin
  200.             if TheL = 0 then
  201.                 ConvertAnswer := 'Cancel'
  202.             else if HiWord(TheL) = 240 then
  203.                 begin
  204.                     GetItem(TheMenus[HiWord(TheL) - 240], LoWord(TheL), TheSecondary);
  205.                     ConvertAnswer := TheSecondary;
  206.                 end
  207.             else
  208.                 begin
  209.                     GetItem(TheMenus[0], HiWord(TheL) - 240, ThePrimary);
  210.                     GetItem(TheMenus[HiWord(TheL) - 240], LoWord(TheL), TheSecondary);
  211.                     ConvertAnswer := Str255(concat(ThePrimary, ',', TheSecondary))
  212.                 end;
  213.         end;
  214.  
  215. {--CleanUpMess takes care of the very important work of cleaning up the---}
  216. {---heap before handing the reins back to Hypercard---}
  217.         procedure CleanUpMess;
  218.             var
  219.                 x: integer;
  220.         begin
  221.             DisposeWindow(PinUpWindow);
  222.             for x := 0 to 15 do
  223.                 if TheMenus[x] <> nil then
  224.                     begin
  225.                         DeleteMenu(240 + x);
  226.                         DisposeMenu(TheMenus[x]);
  227.                     end;
  228.         end;
  229.  
  230.  
  231. {---Here is the code for the procedure MAIN, it acts at the highest level---}
  232. {--farming out almost all of the tasks to its other procedures and functions---}
  233.     begin
  234.         GetPort(OldPort);
  235.         TheAnswer := 'Cancel';
  236.         if GetParams then
  237.             begin
  238.                 ComputeWindowRect;
  239.                 CreateWindow;
  240.                 BuildThoseMenus;
  241.                 if HitCameInWindow then
  242.                     begin
  243.                         Item := PopUpMenuSelect(TheMenus[0], EndRect.bottom + 4, EndRect.left, 0);
  244.                         TheAnswer := ConvertAnswer(Item);
  245.                     end;
  246.                 SetPort(OldPort);
  247.                 CleanUpMess;
  248.             end;
  249.         ParamPtr^.returnvalue := PastoZero(ParamPtr, TheAnswer);
  250.     end;
  251. end.